home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Add-Ons / BBEdit / MacBob 1.0ß2 / Source / Bob / Memory.cp < prev    next >
Encoding:
Text File  |  1995-12-12  |  13.7 KB  |  684 lines  |  [TEXT/KAHL]
  1. /***
  2.   *
  3.   *    Memory.cp - memory manager
  4.   *
  5.   *    Original code: Copyright (c) 1991, by David Michael Betz.  All rights reserved
  6.   *    Modifications and additions: Copyright © by Christopher E. Hyde, 1995
  7.   *
  8.   ***/
  9.  
  10. #include "bob.h"
  11.  
  12. #define    qCheckStack    1
  13. #if qDebug
  14. #define    qDebugGC        0
  15. #else
  16. #define    qDebugGC        0
  17. #endif
  18.  
  19. // Allocation unit
  20. typedef char* AUnit;
  21. enum {
  22.     kAUSize            =    sizeof(AUnit),
  23.     kMinStackSpace    =    0x40                // Min stack space (bytes) before aborting GC
  24. };
  25. #define    AllocSize(x)        (((x) + kAUSize - 1) / kAUSize)
  26.  
  27. // Block flags
  28. #if 0
  29.     #define    IsMarked(h)        ((h)->fFlags & kMark)
  30.     #define    IsUnmarked(h)        (((h)->fFlags & kMark) == 0)
  31.     #define    Mark1(h)            (h)->fFlags |= kMark
  32.     #define    Mark0(h)            (h)->fFlags &= ~kMark
  33. #else
  34.     #define    IsMarked(h)        ((h)->fFlags)
  35.     #define    IsUnmarked(h)        (!(h)->fFlags)
  36.     #define    Mark1(h)            (h)->fFlags = kMark
  37.     #define    Mark0(h)            (h)->fFlags = !kMark
  38. #endif
  39.  
  40. // Size of each type of memory segment
  41. #define    VCompare(f,s,t)    ((f) + (s) <= (t))
  42. #define    VSegSize(n)        (sizeof(TVSegment) - kAUSize + (n) * kAUSize) // Compute the size of a segment
  43. #define    btow_size(n)        (((n) + kAUSize - 1) / kAUSize)    // Convert a byte size to a word size
  44.  
  45. // Vector segment structure
  46. struct TVSegment {
  47.     TVSegment*    fNext;            // next vector segment
  48.     AUnit*        fFree;            // next free location in this segment
  49.     AUnit*        fTop;            // top of segment (plus one)
  50.     AUnit        fData[1];        // segment data
  51. };
  52.  
  53. // Global variables
  54. TValue symbols;                    // the symbol table
  55. TValue classes;                    // the class table
  56. TValue stdin_iostream;            // standard input i/o stream
  57. TValue stdout_iostream;            // standard output i/o stream
  58. TValue stderr_iostream;            // standard error i/o stream
  59. TValue gNil;                    // the nil value
  60.  
  61. // Vector (and string) space
  62. static TVSegment*    vsegments = nil;    // list of vector segments
  63. static TVSegment*    vscurrent = nil;    // current vector segment
  64. static AUnit*        vfree = nil;        // next free location in current segment
  65. static AUnit*        vtop = nil;            // top of current segment
  66.  
  67. // External variables
  68. extern Vector code;                // currently executing code vector
  69.  
  70. // Forward declarations
  71. static Head        AllocMemory        (int type, int size);
  72. static bool        CheckVMemory    (int size);
  73. static bool        VExpand            (int size);
  74.  
  75. // Types, variables & macros for helping with Mark()
  76. typedef void (*MarkFn) (Head hdr);
  77. static MarkFn pMarker[_tMarkMax - _tMarkMin + 1];
  78. static UInt32 pMinStack;
  79. //#define    SetMarkFn(t,f)    pMarker[t - _tMarkMin] = MarkFn(Mark##f)
  80. #define    SetMarkFn(t,f)    *m++ = MarkFn(Mark##f)
  81. #define    InitMarkFn(n)    SetMarkFn(t##n, n)
  82. #define    NoMarkFn(n)    SetMarkFn(t##n, Nothing)
  83.  
  84.  
  85. extern "C" {
  86. #pragma parameter __D0 MyGetApplLimit
  87. extern pascal UInt32 MyGetApplLimit (void) = {0x2038, 0x0130};    // MOVE.L  $0130,D0
  88. #pragma parameter __D0 GetCurrentStack
  89. extern pascal UInt32 GetCurrentStack (void) = 0x200F;                // MOVE.L  A7,D0
  90. #pragma parameter __D0 MyStackSpace
  91. extern pascal long MyStackSpace (void) = {
  92.     0x200F,                // MOVE.L    A7,D0
  93.     0x90B8, 0x0130        // SUB.L        0x0130,D0
  94. };
  95. }
  96.  
  97.  
  98. // Initialize the virtual machine
  99. void
  100. Initialize (int maxStack)
  101. {
  102.         // Allocate the stack
  103.     stkbase = (Value) Calloc(maxStack, kValueSize);
  104.     stktop = sp = stkbase + maxStack;
  105.     code = nil;
  106.  
  107.         // Initialize the memory manager
  108.     vsegments = vscurrent = nil;
  109.     vfree = vtop = nil;
  110.  
  111.         // Initialize globals
  112.     set_nil(&symbols);
  113.     set_nil(&classes);
  114.     set_nil(&stdin_iostream);
  115.     set_nil(&stdout_iostream);
  116.     set_nil(&stderr_iostream);
  117.     set_nil(&gNil);
  118.  
  119.         // Create the initial segment
  120.     if (!VExpand(kAllocUnits))
  121.         Fail(memFullErr);
  122.  
  123.         // Create the symbol and class tables
  124.     set_dictionary(&symbols, NewDict(&gNil));
  125.     set_dictionary(&classes, NewDict(&gNil));
  126.  
  127.         // Enter the built-in functions
  128.     InitFunctions();
  129.  
  130. #if !__powerc
  131.     extern void HackInterpretFn (void);
  132.     if (Opt(PatchCode))
  133.         HackInterpretFn();
  134. #endif
  135.  
  136.     static void    MarkNothing    (Head hdr);
  137.     static void    MarkClass    (Class aClass);
  138.     static void    MarkDict    (Dict dict);
  139.     static void    MarkEntry    (Entry entry);
  140.     static void    MarkObject    (Object obj);
  141.     static void    MarkVector    (Vector vect);
  142.  
  143.     MarkFn* m = pMarker;
  144.  
  145.     InitMarkFn(Class);
  146.     InitMarkFn(Object);
  147.     InitMarkFn(Vector);
  148.       NoMarkFn(String);
  149.       NoMarkFn(ByteCode);
  150.     InitMarkFn(Dict);
  151.      SetMarkFn(tVar, Entry);
  152.       NoMarkFn(Stream);
  153.  
  154.     pMinStack = MyGetApplLimit() + kMinStackSpace;
  155. }
  156.  
  157.  
  158. // Add an entry to a dictionary
  159. Entry
  160. AddEntry (Value dict, KStr key, int type)
  161. {
  162.     static Entry    NewEntry (Value dict, KStr key, int type);
  163.  
  164.     Entry entry;
  165.  
  166.     if ((entry = FindEntry(dict, key)) == nil) {
  167.         check(1);
  168.         push_var(NewEntry(dict, key, type));
  169.         sp->fVar->fNext = DictContents(dict);
  170.         DictContents(dict) = *sp;
  171.         entry = deaddr(sp++);
  172.     }
  173.     return entry;
  174. }
  175.  
  176.  
  177. // Find an entry in a dictionary
  178. Entry
  179. FindEntry (ConstValue dict, KStr key)
  180. {
  181.     for (Value entry = &DictContents(dict); !isnil(entry); entry = degetnext(entry)) {
  182.         int len = SLen(degetkey(entry));
  183.         if (len == strlen(key) && strncmp(key, SData(degetkey(entry)), len) == 0)
  184.             return deaddr(entry);
  185.     }
  186.  
  187.     return nil;
  188. }
  189.  
  190.  
  191. // Make an initialized string from an array of chars
  192. String
  193. MakeString (KStr str, int length)
  194. {
  195.     String val = NewString(length);
  196.  
  197.     memcpy(val->fData, str, length);
  198.     return val;
  199. }
  200.  
  201.  
  202. // Make an initialized string from a C-style string
  203. String
  204. MakeString (KStr str)
  205. {
  206.     return MakeString(str, strlen(str));
  207. }
  208.  
  209.  
  210. // Get a C-style version of a string
  211. char*
  212. GetCString (char* buf, int max, Value str)
  213. {
  214.     int len = SLen(str);
  215.  
  216.     if (len >= max)
  217.         len = max - 1;
  218.     strncpy(buf, SData(str), len);
  219.     buf[len] = '\0';
  220.     return buf;
  221. }
  222.  
  223.  
  224. // Allocate a new string object
  225. String
  226. NewString (int n)
  227. {
  228.     String    val = (String) AllocMemory(tString, TString::CalcSize(n));
  229.  
  230.     val->fLength = n;
  231.     for (char* p = val->fData; --n >= 0; )
  232.         *p++ = '\0';
  233.     return val;
  234. }
  235.  
  236.  
  237. // Allocate a new object
  238. Object
  239. NewObject (Value aClass)
  240. {
  241.     int        n = clgetsize(aClass);
  242.     Object    val = (Object) AllocMemory(tObject, TObject::CalcSize(n));
  243.  
  244.     val->fClass = *aClass;
  245.     for (Value p = val->fMembers; --n >= 0; ++p)
  246.         p->fType = tNil;
  247.     return val;
  248. }
  249.  
  250.  
  251. // Allocate a new vector
  252. Vector
  253. NewVector (int n)
  254. {
  255.     Vector    val = (Vector) AllocMemory(tVector, TVector::CalcSize(n));
  256.  
  257.     val->fLength = n;
  258.     for (Value p = val->fData; --n >= 0; ++p)
  259.         p->fType = tNil;
  260.     return val;
  261. }
  262.  
  263.  
  264. // Create a new class
  265. Class
  266. NewClass (KStr name, Value base)
  267. {
  268.         // Allocate the memory for the new class
  269.     check(1);
  270.     Class aClass = (Class) AllocMemory(tClass, sizeof(TClass));
  271.     push_class(aClass);
  272.     aClass->cl_size = 0;
  273.     set_nil(&aClass->cl_name);
  274.     set_nil(&aClass->cl_members);
  275.     set_nil(&aClass->cl_functions);
  276.  
  277.         // Initialize
  278. //    sp->fClass->cl_base = *base;
  279.     aClass->cl_base = *base;
  280.     set_string(&sp->fClass->cl_name, MakeString(name));
  281.     set_dictionary(&sp->fClass->cl_members, NewDict(sp));
  282.     set_dictionary(&sp->fClass->cl_functions, NewDict(sp));
  283.  
  284.         // Return the new class
  285.     return claddr(sp++);
  286. }
  287.  
  288.  
  289. // Create a new dictionary
  290. Dict
  291. NewDict (Value aClass)
  292. {
  293.     Dict dict = (Dict) AllocMemory(tDict, sizeof(TDict));
  294.     dict->fClass = *aClass;
  295.     set_nil(&dict->fContents);
  296.     return dict;
  297. }
  298.  
  299.  
  300. // Allocate a new dictionary entry
  301. static Entry
  302. NewEntry (Value dict, KStr key, int type)
  303. {
  304.     check(1);
  305.     Entry entry = (Entry) AllocMemory(tVar, sizeof(TEntry));
  306.     push_var(entry);
  307.     entry->fType = type;
  308.     entry->fDict = *dict;
  309.     set_nil(&entry->fKey);
  310.     set_nil(&entry->fValue);
  311.     set_nil(&entry->fNext);
  312.     set_string(&sp->fVar->fKey, MakeString(key));
  313.     return deaddr(sp++);
  314. }
  315.  
  316.  
  317. // Create a new i/o stream
  318. Stream
  319. NewIOStream (CStream& stream)
  320. {
  321.     Stream ios = (Stream) AllocMemory(tStream, sizeof(TStream));
  322.     ios->fStream = &stream;
  323.     return ios;
  324. }
  325.  
  326.  
  327. // Allocate a block of memory
  328. static Head
  329. AllocMemory (int type, int size)
  330. {
  331.     static bool    FindVMemory    (int size);
  332.  
  333.         // Make sure there's enough space
  334.     size = AllocSize(size);
  335.     if (!VCompare(vfree, size, vtop) && !CheckVMemory(size) && !FindVMemory(size))
  336.         Error("Insufficient memory");
  337.  
  338.         // Allocate the next available block
  339.     Head val = (Head) vfree;
  340.     vfree += size;
  341.  
  342.         // Return the new block of memory
  343.     val->fHType = type;
  344.     val->fFlags = 0;
  345.     val->fChain = nil;
  346.     return val;
  347. }
  348.  
  349.  
  350. // Find vector memory
  351. static bool
  352. FindVMemory (int size)
  353. {
  354.     static bool    MakeVMemory    (int size);
  355.  
  356.         // Try garbage collecting
  357.     GC();
  358.  
  359.         // Check to see if we found enough memory
  360.     if (VCompare(vfree, size, vtop) || CheckVMemory(size))
  361.         return true;
  362.  
  363.         // Expand vector space (last resort)
  364.     return MakeVMemory(size);
  365. }
  366.  
  367.  
  368. #define    VSaveCurrent()        {    if (vscurrent != nil)            \
  369.                                 vscurrent->fFree = vfree;    \
  370.                         }
  371. #define    VSetCurrent(s)        {    VSaveCurrent();        \
  372.                             vfree = s->fFree;        \
  373.                             vtop   = s->fTop;        \
  374.                             vscurrent = s;            \
  375.                         }
  376.  
  377.  
  378. // Check for vector memory
  379. static bool
  380. CheckVMemory (int size)
  381. {
  382.     for (TVSegment* vseg = vsegments; vseg != nil; vseg = vseg->fNext)
  383.         if (vseg != vscurrent && VCompare(vseg->fFree, size, vseg->fTop)) {
  384.             VSetCurrent(vseg);
  385.             return true;
  386.         }
  387.     return false;
  388. }
  389.  
  390.  
  391. // Make vector memory
  392. static bool
  393. MakeVMemory (int size)
  394. {
  395.     return VExpand(size < kAllocUnits ? kAllocUnits : size);
  396. }
  397.  
  398.  
  399. // Expand vector space
  400. static bool
  401. VExpand (int size)
  402. {
  403.     static TVSegment*    NewVSegment    (UInt32 n);
  404.  
  405.         // Allocate the new segment
  406.     TVSegment* vseg = NewVSegment(size);
  407.  
  408.         // Make the new segment current
  409.     VSetCurrent(vseg);
  410.  
  411.     return true;
  412. }
  413.  
  414.  
  415. // Create a new vector segment & initialize it
  416. static TVSegment*
  417. NewVSegment (UInt32 n)
  418. {
  419. #if qDebugGC
  420.     PrintErrF("\t\t••• NewVSegment(%d)\r", VSegSize(n));
  421. #endif
  422.  
  423.         // Allocate the new segment
  424.     TVSegment* newseg = (TVSegment*) Calloc(1, VSegSize(n));
  425.  
  426.         // Initialize the new segment
  427.     newseg->fFree = newseg->fData;
  428.     newseg->fTop  = newseg->fFree + n;
  429.     newseg->fNext = vsegments;
  430.  
  431.         // Return the new segment
  432.     return vsegments = newseg;
  433. }
  434.  
  435.  
  436. // Garbage collect
  437. void
  438. GC (void)
  439. {
  440.     static void    Compact    (void);
  441.  
  442.     Info("GC");
  443.  
  444.         // Protect the current bytecode vector
  445.     extern CodePtr cbase, gPC;
  446.     TValue codeval;
  447.     int pcoff;
  448.     if (code) {
  449.         set_bytecode(&codeval, code);
  450.         pcoff = gPC - cbase;
  451.         Mark(&codeval);
  452.     }
  453.  
  454.         // Mark all reachable values
  455.     Mark(&stdin_iostream);
  456.     Mark(&stdout_iostream);
  457.     Mark(&stderr_iostream);
  458.     Mark(&symbols);
  459.     Mark(&classes);
  460.  
  461.         // Mark the stack
  462.     for (Value p = sp; p < stktop; )
  463.         Mark(p++);
  464.  
  465.         // Mark compiler variables
  466.     MarkCompiler();
  467.  
  468.         // Compact all active blocks
  469.     Compact();
  470.  
  471.         // Reload the interpreter's registers
  472.     if (code) {
  473.         code = codeval.fVec;
  474.         cbase = (uchar*) code->fData[0].fStr->fData;
  475.         gPC = cbase + pcoff;
  476.     }
  477. }
  478.  
  479.  
  480. // Mark all accessible nodes
  481. void
  482. Mark (Value val)
  483. {
  484.     if (val->fType >= _tMarkMin && val->fType <= _tMarkMax) {
  485.         Head hdr = val->fHead;
  486.         val->fChain = hdr->fChain;
  487.         hdr->fChain = val;
  488.         if (IsUnmarked(hdr)) {
  489.             Mark1(hdr);
  490. #if qCheckStack
  491. //            if (MyStackSpace() < kMinStackSpace)
  492.             if (GetCurrentStack() < pMinStack)
  493.                 Fail(errTooMuchRecursion);
  494. #endif
  495.                 // Do nothing: tString, tByteCode, tStream
  496.             (*pMarker[hdr->fHType - _tMarkMin])(hdr);
  497.         }
  498.     }
  499. }
  500.  
  501.  
  502. // Mark nothing
  503. static void
  504. MarkNothing (Head hdr)
  505. {
  506.     // Do nothing
  507. }
  508.  
  509.  
  510. // Mark a class
  511. static void
  512. MarkClass (Class aClass)
  513. {
  514. #if 1
  515.     Mark(&aClass->cl_name);
  516. #else
  517.     String hdr = aClass->cl_name;
  518.     aClass->cl_name = hdr->fChain;
  519.     hdr->fChain = val;
  520.     if (IsUnmarked(hdr))
  521.         Mark1(hdr);
  522. #endif
  523.     Mark(&aClass->cl_base);
  524.     Mark(&aClass->cl_members);
  525.     Mark(&aClass->cl_functions);
  526. }
  527.  
  528.  
  529. // Mark a dictionary
  530. static void
  531. MarkDict (Dict dict)
  532. {
  533.     Mark(&dict->fClass);
  534.  
  535.     for (Value next, val = &dict->fContents; !isnil(val); val = next) {
  536.         next = degetnext(val);
  537.         Mark(val);
  538.     }
  539. }
  540.  
  541.  
  542. // Mark a dictionary entry
  543. static void
  544. MarkEntry (Entry entry)
  545. {
  546.     Mark(&entry->fDict);
  547.     Mark(&entry->fKey);
  548.     Mark(&entry->fValue);
  549. }
  550.  
  551.  
  552. // Mark an object
  553. static void
  554. MarkObject (Object obj)
  555. {
  556.     Value p = obj->fMembers;
  557.     int n = clgetsize(&obj->fClass);
  558.  
  559.     while (--n >= 0)
  560.         Mark(p++);
  561. }
  562.  
  563.  
  564. // Mark a vector
  565. static void
  566. MarkVector (Vector vect)
  567. {
  568.     Value p = vect->fData;
  569.     int n = vect->fLength;
  570.  
  571.     while (--n >= 0)
  572.         Mark(p++);
  573. }
  574.  
  575.  
  576. // Compact all vector space
  577. static void
  578. Compact (void)
  579. {
  580.     static void    Compact    (TVSegment* vseg);
  581.  
  582.         // Store the current segment information
  583.     VSaveCurrent();
  584.  
  585.         // Compact each vector segment
  586.     for (TVSegment* vseg = vsegments; vseg != nil; vseg = vseg->fNext)
  587.         Compact(vseg);
  588.  
  589.         // Make the first vector segment current
  590.     if ((vscurrent = vsegments) != nil) {
  591.         vfree = vscurrent->fFree;
  592.         vtop  = vscurrent->fTop;
  593.     }
  594. }
  595.  
  596.  
  597. // Get the size of a block
  598. static int
  599. GetBlockSize (Head hdr)
  600. {
  601.     switch (hdr->fHType) {
  602.         case tClass:
  603.             return AllocSize(sizeof(TClass));
  604.         case tObject:
  605. //            return AllocSize(TObject::CalcSize(clgetsize(&Object(hdr)->fClass)));
  606.             return AllocSize(sizeof(TObject)
  607.                  + (clgetsize(&Object(hdr)->fClass) - 1) * kValueSize);
  608.         case tVector:
  609.             return AllocSize(TVector::CalcSize(Vector(hdr)->fLength));
  610.         case tString:
  611.             return AllocSize(TString::CalcSize(String(hdr)->fLength));
  612.         case tDict:
  613.             return AllocSize(sizeof(TDict));
  614.         case tVar:
  615.             return AllocSize(sizeof(TEntry));
  616.         case tStream:
  617.             return AllocSize(sizeof(TStream));
  618.     }
  619.     Error("Bad block type: %d", hdr->fHType);
  620. //    return 0;
  621. }
  622.  
  623.  
  624. // Compact a vector segment
  625. static void
  626. Compact (TVSegment* vseg)
  627. {
  628.     AUnit*    vnext;
  629.     Value    vp, nextvp;
  630.     int        vsize;
  631.     Head    hdr;
  632.  
  633.     // update pointers
  634.     AUnit* vdata = vnext = vseg->fData;
  635.     AUnit* vfree = vseg->fFree;
  636.  
  637. #if qDebugGC
  638.     PrintErrF("\t\t••• Compacting seg: 0x%X, %d ", vseg, vseg->fTop - vseg->fFree);
  639. #endif
  640.  
  641.     while (vdata < vfree) {
  642.         hdr = (Head) vdata;
  643.         vsize = GetBlockSize(hdr);
  644.         if (IsMarked(hdr)) {
  645.             for (vp = hdr->fChain; vp != nil; vp = nextvp) {
  646.                 nextvp = vp->fChain;
  647.                 vp->fHead = (Head) vnext;
  648.             }
  649.             hdr->fChain = nil;
  650.             vnext += vsize;
  651.         } else {
  652.             switch (hdr->fHType) {
  653.             case tStream:
  654.                 Stream(hdr)->fStream->Close();
  655.                 break;
  656.             }
  657.         }
  658.         vdata += vsize;
  659.     }
  660.  
  661.     // Compact free space
  662.     vdata = vnext = vseg->fData;
  663.     vfree = vseg->fFree;
  664.     while (vdata < vfree) {
  665.         hdr = (Head) vdata;
  666.         vsize = GetBlockSize(hdr);
  667.         if (IsMarked(hdr)) {
  668.             Mark0(hdr);
  669.             if (vdata == vnext) {
  670.                 vdata += vsize;
  671.                 vnext += vsize;
  672.             } else
  673.                 while (--vsize >= 0)
  674.                     *vnext++ = *vdata++;
  675.         } else
  676.             vdata += vsize;
  677.     }
  678.     vseg->fFree = vnext;
  679.  
  680. #if qDebugGC
  681.     PrintErrF("=> %d\r", vseg->fTop - vseg->fFree);
  682. #endif
  683. }
  684.